INTRODUCCIÒN

Se determina el modelo ARIMA de todos los productos y servicios con frecuencia semanal.

ruta_totales <- "/cloud/project/totales_transformados.xlsx"
excel_sheets(ruta_totales)
## [1] "Sheet 1"
totales_transformados <- as.data.frame(read_xlsx(ruta_totales,
                                                 sheet = "Sheet 1"), col.names = T)
nrow(totales_transformados)
## [1] 773
head(totales_transformados)
##   Indice      Fecha     Totales
## 1      1 2019-07-03 -1.45928656
## 2      2 2019-07-04 -1.16603428
## 3      3 2019-07-05  0.76901746
## 4      4 2019-07-06  0.09313228
## 5      5 2019-07-08  0.47168104
## 6      6 2019-07-09 -1.30148853

Agrupando por semana

totales_transformados$Semana <- format(totales_transformados$Fecha, 
                                       format = c("%Y-%U"))
totales_transformados <- totales_transformados %>%
  group_by(Fecha = as.character(Semana)) %>%
  summarize(Totales = sum(Totales), 
            .groups = "keep")
head(totales_transformados)
## # A tibble: 6 × 2
## # Groups:   Fecha [6]
##   Fecha   Totales
##   <chr>     <dbl>
## 1 2019-26  -1.76 
## 2 2019-27  -1.71 
## 3 2019-28   1.45 
## 4 2019-29  -0.835
## 5 2019-30  -0.605
## 6 2019-31   1.43
nrow(totales_transformados)
## [1] 249

Se crean las series temporales semanales tipo ts y xts

Total_Ventas_ts <- ts(totales_transformados$Totales, start = 1,frequency = 1)
Total_Ventas_xts <- as.xts(Total_Ventas_ts, dateFormat = "POSIXct")

Gráfica

Raíz Unitaria

urca::ur.df(Total_Ventas_ts)
## 
## ############################################################### 
## # Augmented Dickey-Fuller Test Unit Root / Cointegration Test # 
## ############################################################### 
## 
## The value of the test statistic is: -14.7188

El valor del estadistico de Dickey-Fuller es -19.3184. Este resultado, significativamente menor que el valor critico, y permite rechazar la hipotesis nula de que la serie tiene una raiz unitaria (es decir, no es estacionaria) a un nivel de significancia del 5%. En consecuencia, se concluye que la serie de tiempo es estacionaria.

kpss.test(Total_Ventas_ts)
## Warning in kpss.test(Total_Ventas_ts): p-value greater than printed p-value
## 
##  KPSS Test for Level Stationarity
## 
## data:  Total_Ventas_ts
## KPSS Level = 0.058097, Truncation lag parameter = 5, p-value = 0.1

KPSS Level = 0.032192, Truncation lag parameter = 5, p-value = 0.1 Ho:La serie de tiempo es estacionaria. Ha:La serie de tiempo no es estacionaria. Dado que el valor p es 0.1, mayor al nivel de significancia convencional de 0.05, no se rechaza la hipótesis nula.

Funciones de autocorrelación y autocorrelación parcial

ggAcf(Total_Ventas_ts, col = "red", lag.max = 30) 

ggPacf(Total_Ventas_ts, col = "blue", lag.max = 20)

Se divide la serie en una proporcion 80% - 20%

dividida_total <- ts_split(ts.obj = Total_Ventas_ts, 
                           sample.out = round(length(Total_Ventas_ts)*0.2))

entrena_total <- dividida_total$train #Serie de entrenamiento

prueba_total <- dividida_total$test # Serie de prueba

Modeloa ARIMA

modelo_Totales_sem <- auto.arima(entrena_total, seasonal = F,stepwise = F)
summary(modelo_Totales_sem)
## Series: entrena_total 
## ARIMA(3,0,0) with zero mean 
## 
## Coefficients:
##           ar1      ar2     ar3
##       -0.3793  -0.0547  0.1819
## s.e.   0.0698   0.0748  0.0696
## 
## sigma^2 = 3.277:  log likelihood = -399.09
## AIC=806.19   AICc=806.4   BIC=819.36
## 
## Training set error measures:
##                     ME     RMSE      MAE MPE MAPE      MASE         ACF1
## Training set 0.1207345 1.796576 1.427317 Inf  Inf 0.5330092 -0.004328374
# AIC=806.19   AICc=806.4   BIC=819.36

Resisduales

checkresiduals(modelo_Totales_sem, col ="red") # p-value = 0.9537

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(3,0,0) with zero mean
## Q* = 2.1067, df = 7, p-value = 0.9537
## 
## Model df: 3.   Total lags used: 10

Pronóstico

pronostico_totales_sem <- forecast(modelo_Totales_sem, 
                                   h = length(prueba_total), level = 0.95)

Criterio AIC

AIC(modelo_Totales_sem) # [1] 806.189
## [1] 806.189

Gráfica del pronóstico

Exactitud a 10 semanas

accuracy(pronostico_totales_sem$mean[1:10], prueba_total[1:10])
##                  ME     RMSE      MAE      MPE     MAPE
## Test set -0.3869886 2.076088 1.562841 95.51638 95.51638
#                  ME     RMSE      MAE      MPE     MAPE
# Test set -0.3869886 2.076088 1.562841 95.51638 95.51638

Gráfica

plot(prueba_total[1:10],type = "l", col = "green", 
     main = "Pronostico diario de productos y servicios", ylim = c(-8,8), 
     xlab = "Semanas", ylab = "Valores")
lines(pronostico_totales_sem$mean[1:10], type = "l", col = "darkred", lwd = 1, lty = 2)
legend("bottomleft", legend = c( "prueba", "pronostico"),
       fill = c("green",  "darkred"), cex = 0.6, lty = c(1,2))

Exactitud total

accuracy(pronostico_totales_sem$mean, prueba_total)
##                ME     RMSE      MAE           MPE         MAPE       ACF1
## Test set 0.108084 2.175049 1.766448 -807483365685 808846209369 -0.2972335
##          Theil's U
## Test set 0.9999958
#                ME     RMSE      MAE           MPE         MAPE      
# Test set 0.108084 2.175049 1.766448 -807483365685 808846209369